home *** CD-ROM | disk | FTP | other *** search
/ ShareWare OnLine 2 / ShareWare OnLine Volume 2 (CMS Software)(1993).iso / prog / gageblox.zip / GAGEBLOX.ASI next >
Text File  |  1993-02-28  |  13KB  |  575 lines
  1. dim gag&(81)
  2. dim row(81)
  3. dim col(81)
  4. dim trh(81)
  5. data 1001&,1002&,1003&,1004&,1005&,1006&,1007&,1008&,1009&
  6. data 1010&,1020&,1030&,1040&,1050&,1060&,1070&,1080&,1090&,1100&
  7. data 1110&,1120&,1130&,1140&,1150&,1160&,1170&,1180&,1190&,1200&
  8. data 1210&,1220&,1230&,1240&,1250&,1260&,1270&,1280&,1290&,1300&
  9. data 1310&,1320&,1330&,1340&,1350&,1360&,1370&,1380&,1390&,1400&
  10. data 1410&,1420&,1430&,1440&,1450&,1460&,1470&,1480&,1490&
  11. data 500&,1000&,1500&,2000&,2500&,3000&,3500&,4000&,4500&,5000&
  12. data 5500&,6000&,6500&,7000&,7500&,8000&,8500&,9000&,9500&
  13. data 10000&,20000&,30000&,40000&
  14. data 3,3,3,3,3,3,3,3,3,4,4,4,4,4,4,4,4,4,5,5,5,5,5,5,5,5,5,5,6
  15. data 6,6,6,6,6,6,6,6,6,7,7,7,7,7,7,7,7,7,7,8,8,8,8,8,8,8,8,8,8
  16. data 9,9,9,9,9,9,9,9,9,10,10,10,10,10,10,10,10,10,10,11,11,11,11
  17. data 10,18,26,34,42,50,58,66,74,10,18,26,34,42,50,58,66,74
  18. data 2,10,18,26,34,42,50,58,66,74,2,10,18,26,34,42,50,58,66,74
  19. data 2,10,18,26,34,42,50,58,66,74,2,10,18,26,34,42,50,58,66,74
  20. data 10,18,26,34,42,50,58,66,74,2,10,18,26,34,42,50,58,66,74,26,34,42,50
  21. 2zero$=".00"
  22. decpt$="."
  23. spac$=" "
  24. zero$=chr$(0)
  25. fifnin$=chr$(59)
  26. sevone$=chr$(71)
  27. sevtwo$=chr$(72)
  28. sevfiv$=chr$(75)
  29. sevsev$=chr$(77)
  30. eighty$=chr$(80)
  31. eigtwo$=chr$(82)
  32. eigthr$=chr$(83)
  33. fone$=zero$+fifnin$
  34. esc$=chr$(27)
  35. uparr$=zero$+sevtwo$
  36. dnarr$=zero$+eighty$
  37. rtarr$=zero$+sevsev$
  38. lfarr$=zero$+sevfiv$
  39. home$=zero$+sevone$
  40. ins$=zero$+eigtwo$
  41. del$=zero$+eigthr$
  42. for x=1 to 81
  43.     read gag&(x)
  44. next x
  45. for x=1 to 81
  46.     read row(x)
  47. next x
  48. for x=1 to 81
  49.     read col(x)
  50. next x
  51. begin: cls
  52.     color 7,4
  53.     gosub newtab:
  54.     color 4,7
  55.     locate 1,35
  56.     print " GAGE-BLOX "
  57.       locate 22,25
  58.       print " F1 "
  59.       locate 22,44
  60.       print " ESC "
  61.     color 7,1
  62.     locate 14,14
  63.     print " GAGE-BLOX -- The values in the above table represent "
  64.     locate 15,14
  65.     print " decimal inch thicknesses of each block in a standard "
  66.     locate 16,14
  67.     print " 82-block English-system gage block set.  F1 to enter "
  68.     locate 17,14
  69.     print " the calculator. Read the instructions on that screen "
  70.     locate 18,14
  71.     print " for operation. Checked but accuracy at risk of user. "
  72.       color 7,4
  73.       locate 22,29
  74.       print " CALCULATE "
  75.       locate 22,49
  76.       print " EXITS "
  77.         effloop:
  78.            a$=inkey$
  79.            if a$=fone$ then manual:
  80.            if a$=esc$ then leave:
  81.         goto effloop:
  82. manual: cls
  83.      mode$="manual"
  84.      color 4,7
  85.      locate 1,35
  86.      print " GAGE-BLOX "
  87.      locate 13,23
  88.      print " MANUAL MODE "
  89.      locate 21,20
  90.      print " INS  "
  91.      locate 21,42
  92.      print " DEL "
  93.      locate 23,20
  94.      print " HOME "
  95.      locate 23,42
  96.      print " ESC "
  97.      color 7,1
  98.      locate 13,36
  99.      print " F1 to enter AUTO MODE "
  100.      color 7,4
  101.      gosub newtab:
  102.      locate 15,23
  103.      print " Use arrow keys to position cursor. "
  104.      locate 17,25
  105.      print " Current Stack Height = "
  106.      locate 18,25
  107.      print " Program resets any over 9.9999 "
  108.      locate 21,26
  109.      print " Adds Block  "
  110.      locate 21,47
  111.      print " Removes Block "
  112.      locate 23,26
  113.      print " Clear/Reset "
  114.      locate 23,47
  115.      print " EXITS Program "
  116. reset1:
  117.       color 7,4
  118.       gosub newtab:
  119.       stack&=0
  120.       stack$=" 0.0000 "
  121.       gage=1
  122.       color 4,7
  123.       goto prt:
  124. in1:
  125.     if trh(gage)=0 then
  126.        color 7,12
  127.        endif
  128.     if trh(gage)=1 then
  129.        color 15,12
  130.        endif
  131.     gosub prtgag:
  132.     in1loop:
  133.             a$=inkey$
  134.             if a$=fone$ then auto:
  135.             if a$=uparr$ then upcur:
  136.             if a$=dnarr$ then dwncur:
  137.             if a$=rtarr$ then ritcur:
  138.             if a$=lfarr$ then lefcur:
  139.             if a$=ins$ then addblk:
  140.             if a$=del$ then remblk:
  141.             if a$=home$ then reset1:
  142.             if a$=esc$ then leave:
  143.     goto in1loop:
  144. replc:
  145.       if trh(gage)=0 then unselect:
  146. reselect:
  147.          color 15,4
  148.          gosub prtgag:
  149.          return
  150. unselect:
  151.          color 7,4
  152.          gosub prtgag:
  153.          return
  154. upcur:
  155.       gosub replc:
  156.       if gage>77 then
  157.          gage=gage-7
  158.          goto in1:
  159.          endif
  160.       if gage>68 then
  161.          gage=gage-10
  162.          goto in1:
  163.          endif
  164.       if gage=68 then
  165.          gage=49
  166.          goto in1:
  167.          endif
  168.       if gage>58 then
  169.          gage=gage-9
  170.          goto in1:
  171.          endif
  172.       if gage>19 then
  173.          gage=gage-10
  174.          goto in1:
  175.          endif
  176.       if gage=19 then in1:
  177.       if gage<10 then in1:
  178.       gage=gage-9
  179.       goto in1:
  180. dwncur:
  181.        gosub replc:
  182.        if gage>74 then in1:
  183.        if gage>70 then
  184.           gage=gage+7
  185.           goto in1:
  186.           endif
  187.        if gage>67 then in1:
  188.        if gage>58 then
  189.           gage=gage+10
  190.           goto in1:
  191.           endif
  192.        if gage>49 then
  193.           gage=gage+9
  194.           goto in1:
  195.           endif
  196.        if gage=49 then
  197.           gage=68
  198.           goto in1:
  199.           endif
  200.        if gage>9 then
  201.           gage=gage+10
  202.           goto in1:
  203.           endif
  204.        gage=gage+9
  205.        goto in1:
  206. ritcur:
  207.        gosub replc:
  208.        if gage=9 then in1:
  209.        if gage=18 then in1:
  210.        if gage=28 then in1:
  211.        if gage=38 then in1:
  212.        if gage=48 then in1:
  213.        if gage=58 then in1:
  214.        if gage=67 then in1:
  215.        if gage=77 then in1:
  216.        if gage=81 then in1:
  217.        gage=gage+1
  218.        goto in1:
  219. lefcur:gosub replc:
  220.        if gage=1 then in1:
  221.        if gage=10 then in1:
  222.        if gage=19 then in1:
  223.        if gage=29 then in1:
  224.        if gage=39 then in1:
  225.        if gage=49 then in1:
  226.        if gage=59 then in1:
  227.        if gage=68 then in1:
  228.        if gage=78 then in1:
  229.        gage=gage-1
  230.        goto in1:
  231. addblk:
  232.        if trh(gage)=1 then in1:
  233.        stack&=stack&+gag&(gage)
  234.        check$=str$(stack&)
  235.        check$=ltrim$(check$)
  236.        check=len(check$)
  237.        if check>5 then reset1:
  238.        trh(gage)=1
  239.        color 4,7
  240.        goto prtstk:
  241. remblk:
  242.        if trh(gage)=0 then in1:
  243.        trh(gage)=0
  244.        stack&=stack&-gag&(gage)
  245.        color 4,7
  246. prtstk:
  247.        stk$=str$(stack&)
  248.        stk$=ltrim$(stk$)
  249.        check=len(stk$)
  250.        if stack&=0 then
  251.           stack$=" 0.0000 "
  252.           goto prt:
  253.        endif
  254.        if stack&=500& then
  255.           stack$=" 0.0500 "
  256.           goto prt:
  257.        endif
  258.        if stack&<10000& then
  259.           if check=5 then glitch:
  260.           stack$=" 0."
  261.           stack$=stack$+stk$
  262.           stack$=stack$+spac$
  263.           goto prt:
  264.        endif
  265.        if stack&>9999& then
  266. glitch:   stack$=left$(stk$,1)
  267.           stk$=right$(stk$,4)
  268.           stack$=spac$+stack$
  269.           stack$=stack$+decpt$
  270.           stack$=stack$+stk$
  271.           stack$=stack$+spac$
  272.        endif
  273. prt:   locate 17,49
  274.        print stack$
  275.        if mode$="manual" then in1:
  276.        if mode$="auto" then in2:
  277. newtab: for x=1 to 81
  278.         trh(x)=0
  279.         gage=x
  280.         gosub prtgag:
  281.         next x
  282. return
  283. prtgag: gage$=str$(gag&(gage))
  284.         gage$=ltrim$(gage$)
  285.         if gage<78 then
  286.            gage$=decpt$+gage$
  287.         endif
  288.         if gage>77 then
  289.            gage$=left$(gage$,1)
  290.            gage$=gage$+2zero$
  291.            gage$=spac$+gage$
  292.         endif
  293.         gage$=gage$+spac$
  294.         if gage=59 then
  295.            gage$=".0500 "
  296.         endif
  297.         locate row(gage),col(gage)
  298.         print gage$
  299. return
  300. leave: color 7,0
  301.        cls
  302.        end
  303. auto: cls
  304.       mode$="auto"
  305.       stack$=" 0.0000 "
  306.       color 7,1
  307.       gosub newtab:
  308.       locate 17,25
  309.       print " Display Stack Height = "
  310.       locate 18,25
  311.       print " Program limit is set at 9.9999 "
  312.       locate 23,26
  313.       print " Start/Reset "
  314.       locate 23,47
  315.       print " EXITS Program "
  316.       color 7,4
  317.       locate 13,34
  318.       print " F1 to enter MANUAL MODE "
  319.       color 1,7
  320.       locate 1,35
  321.       print " GAGE-BLOX "
  322.       locate 13,23
  323.       print " AUTO MODE "
  324.       locate 23,20
  325.       print " HOME "
  326.       locate 23,42
  327.       print " ESC "
  328.       goto prt:
  329. in2: a$=inkey$
  330.      if a$=fone$ then manual:
  331.      if a$=home$ then reset2:
  332.      if a$=esc$ then leave:
  333.      goto in2:
  334. reset2:
  335.       stack$=" 0.0000 "
  336.       color 7,1
  337.       gosub newtab:
  338.       locate 15,23
  339.       print " Enter 5-digit target stack height. "
  340.       locate 17,25
  341.       print "  Target Stack Height = "
  342.       locate 18,25
  343.       color 1,7
  344.       locate 17,49
  345.       print stack$
  346. lp1: color 1,7
  347.      locate 17,50
  348.      a$=inkey$
  349.      if a$="0" then
  350.         print "0.";
  351.         stack$="0."
  352.         goto lp2:
  353.      endif
  354.      if a$="1" then
  355.         print "1.";
  356.         stack$="1."
  357.         goto lp2:
  358.      endif
  359.      if a$="2" then
  360.         print "2.";
  361.         stack$="2."
  362.         goto lp2:
  363.      endif
  364.      if a$="3" then
  365.         print "3.";
  366.         stack$="3."
  367.         goto lp2:
  368.      endif
  369.      if a$="4" then
  370.         print "4.";
  371.         stack$="4."
  372.         goto lp2:
  373.      endif
  374.      if a$="5" then
  375.         print "5.";
  376.         stack$="5."
  377.         goto lp2:
  378.      endif
  379.      if a$="6" then
  380.         print "6.";
  381.         stack$="6."
  382.         goto lp2:
  383.      endif
  384.      if a$="7" then
  385.         print "7.";
  386.         stack$="7."
  387.         goto lp2:
  388.      endif
  389.      if a$="8" then
  390.         print "8.";
  391.         stack$="8."
  392.         goto lp2:
  393.      endif
  394.      if a$="9" then
  395.         print "9.";
  396.         stack$="9."
  397.         goto lp2:
  398.      endif
  399.      if a$=fone$ then manual:
  400.      if a$=home$ then reset2:
  401.      if a$=esc$ then leave:
  402. goto lp1:
  403. lp2: for x=1 to 4
  404.      lp3: a$=inkey$
  405.          if a$="0" then
  406.             print "0";
  407.             stack$=stack$+"0"
  408.             goto nxt:
  409.          endif
  410.          if a$="1" then
  411.             print "1";
  412.             stack$=stack$+"1"
  413.             goto nxt:
  414.          endif
  415.          if a$="2" then
  416.             print "2";
  417.             stack$=stack$+"2"
  418.             goto nxt:
  419.          endif
  420.          if a$="3" then
  421.             print "3";
  422.             stack$=stack$+"3"
  423.             goto nxt:
  424.          endif
  425.          if a$="4" then
  426.             print "4";
  427.             stack$=stack$+"4"
  428.             goto nxt:
  429.          endif
  430.          if a$="5" then
  431.             print "5";
  432.             stack$=stack$+"5"
  433.             goto nxt:
  434.          endif
  435.          if a$="6" then
  436.             print "6";
  437.             stack$=stack$+"6"
  438.             goto nxt:
  439.          endif
  440.          if a$="7" then
  441.             print "7";
  442.             stack$=stack$+"7"
  443.             goto nxt:
  444.          endif
  445.          if a$="8" then
  446.             print "8";
  447.             stack$=stack$+"8"
  448.             goto nxt:
  449.          endif
  450.          if a$="9" then
  451.             print "9";
  452.             stack$=stack$+"9"
  453.             goto nxt:
  454.          endif
  455.          if a$=fone$ then manual:
  456.          if a$=home$ then reset2:
  457.          if a$=esc$ then leave:
  458.          goto lp3:
  459. nxt: next x
  460.      print " "
  461. calstk: carry=0
  462.         a$=mid$(stack$,6,1)
  463.         a=val(a$)
  464.         if a=0 then hund:
  465.         trh(a)=1
  466.         gosub tendock:
  467. hund:   a$=mid$(stack$,4,2)
  468.         a=val(a$)
  469.         if a=0 then tenths:
  470.         if a=50 then
  471.            carry=1
  472.            goto tenths:
  473.         endif
  474.         if a>50 then
  475.            a=a-50
  476.            carry=1
  477.         endif
  478.         b=a+9
  479.         trh(b)=1
  480.         gosub tendock:
  481. tenths:
  482.        a$=mid$(stack$,3,1)
  483.        a=val(a$)
  484.        a=10*a
  485.        if carry=1 then
  486.           a=a+5
  487.        endif
  488.        if a=5 then
  489.           trh(59)=1
  490.           goto units:
  491.        endif
  492.        for x=60 to 77
  493.            a$=str$(gag&(x))
  494.            a$=ltrim$(a$)
  495.            a$=left$(a$,2)
  496.            b=val(a$)
  497.            if a=b then
  498.               trh(x)=1
  499.            endif
  500.        next x
  501. units: a$=left$(stack$,1)
  502.        a=val(a$)
  503.        if a=9 then
  504.           trh(79)=1
  505.           trh(80)=1
  506.           trh(81)=1
  507.         endif
  508.         if a=8 then
  509.            trh(78)=1
  510.            trh(80)=1
  511.            trh(81)=1
  512.         endif
  513.         if a=7 then
  514.            trh(80)=1
  515.            trh(81)=1
  516.         endif
  517.         if a=6 then
  518.            trh(79)=1
  519.            trh(81)=1
  520.         endif
  521.         if a=5 then
  522.            trh(79)=1
  523.            trh(80)=1
  524.          endif
  525.          if a=4 then
  526.             trh(81)=1
  527.          endif
  528.          if a=3 then
  529.             trh(80)=1
  530.          endif
  531.          if a=2 then
  532.             trh(79)=1
  533.          endif
  534.          if a=1 then
  535.             trh(78)=1
  536.          endif
  537. color 15,1
  538. for x=1 to 81
  539.     if trh(x)=1 then
  540.        gage=x
  541.        gosub prtgag:
  542.     endif
  543. next x
  544. color 7,1
  545. locate 15,23
  546. print " MANUAL MODE can be used to verify. "
  547. locate 17,25
  548. print " Display Stack Height = "
  549. goto in2:
  550. tendock:
  551.          a$=mid$(stack$,3,1)
  552.          a=val(a$)
  553.          b$=left$(stack$,1)
  554.          b=val(b$)
  555.          c=a+b
  556.          if c=0 then reset2:
  557.          if a=0 then
  558.             b=asc(b$)
  559.             b=b-1
  560.             stk$=chr$(b)
  561.             stk$=stk$+"."
  562.             stk$=stk$+"9"
  563.             a$=mid$(stack$,4,3)
  564.             stack$=stk$+a$
  565.           return
  566.           endif
  567.           b=asc(a$)
  568.           b=b-1
  569.           b$=chr$(b)
  570.           stk$=left$(stack$,2)
  571.           stk$=stk$+b$
  572.           a$=mid$(stack$,4,3)
  573.           stack$=stk$+a$
  574.           return
  575.